#!/usr/bin/perl

# tested on:
# Jurassic Park
# Dracula
# NHL94
# Joe Montana's NFL Football Cinepak TM For Sega TM

use strict;
use warnings;

my $fourCCFormat = 0;

my @files = @ARGV;

foreach my $file (@files) {
    #&ReadFourCC($file);
    &ReadSGA($file);
}

sub ReadSGA {
    my ($sgaFile) = @_;

    if ( ! open( SGA, $sgaFile ) ) {
	return 0;
    }
    binmode SGA;

    my $sgaSectorRemainder = 0x800;
    my $sgaBytesLeft = -s $sgaFile;

    my $pcmFD = 0;
    my $pcmData = '';

    while ( $sgaBytesLeft > 0 ) {
	my $sgaChunkHeaderStart = '';
	if ( $sgaSectorRemainder < 4 ||
	     $sgaBytesLeft < 4 ||
	     read(SGA,$sgaChunkHeaderStart,4) != 4 ) {
	    print STDERR "not enough characters for a SGA file ($sgaBytesLeft,$sgaSectorRemainder)\n";
	    last;
	    return 0;
	}
	$sgaBytesLeft -= 4;
	$sgaSectorRemainder -= 4;

	my $sgaChunkType = ord(substr($sgaChunkHeaderStart,0,1));
	my $sgaChunkLength = unpack("n",substr($sgaChunkHeaderStart,2,3));

	if ( $sgaChunkType == 0x00 ) {
	    # skip to next sector, not next sector has no chunk remainder header
	    if ( $sgaSectorRemainder > 0 ) {
		if ( $sgaBytesLeft < $sgaSectorRemainder ) {
		    $sgaBytesLeft = 0;
		} else {
		    my $sgaDontCare = '';
		    if ( read(SGA,$sgaDontCare,$sgaSectorRemainder) != $sgaSectorRemainder ) {
			print STDERR "Bad filler space\n";
			return 0;
		    }
		    $sgaBytesLeft -= $sgaSectorRemainder;
		    $sgaSectorRemainder = 0x800;
		}
	    }
	} else {
	    
	    if ( $sgaChunkLength > 0 &&
		 $sgaSectorRemainder < 0 ) {
		my $sgaDontCare = '';
		if ( $sgaBytesLeft < 2 ||
		     read(SGA,$sgaDontCare,2) != 2 ) {
		    print STDERR "not enough characters for a SGA file\n";
		    return 0;
		}
		$sgaBytesLeft -= 2;
		$sgaSectorRemainder = 0x7FE;
	    }

	    # now get the chunk payload
	    my $sgaChunkPayload = '';
	    my $sgaChunkPayloadLengthRemainder = $sgaChunkLength;
	    while ( $sgaChunkPayloadLengthRemainder > 0 ) {
		my $sgaChunkPayloadCat = '';
		if ( $sgaChunkPayloadLengthRemainder > $sgaSectorRemainder ) {
		    my $sgaSectorStartHeader = '';
		    if ( $sgaBytesLeft < $sgaSectorRemainder ||
			 read(SGA,$sgaChunkPayloadCat,$sgaSectorRemainder) != $sgaSectorRemainder ||
			 read(SGA,$sgaSectorStartHeader,2) != 2 ) {
			print STDERR "not enough characters for a SGA file's payload ($sgaBytesLeft,$sgaSectorRemainder)\n";
			return 0;
		    }
		    $sgaBytesLeft -= ( $sgaSectorRemainder - 2 );
		    $sgaChunkPayloadLengthRemainder -= $sgaSectorRemainder;
		    $sgaSectorRemainder = 0x7FE;
		} else {
		    if ( $sgaBytesLeft < $sgaChunkPayloadLengthRemainder ||
			 read(SGA,$sgaChunkPayloadCat,$sgaChunkPayloadLengthRemainder) != $sgaChunkPayloadLengthRemainder ) {
			print STDERR "not enough characters for a SGA file's payload($sgaBytesLeft,$sgaSectorRemainder)\n";
			return 0;
		    }
		    $sgaBytesLeft -= $sgaChunkPayloadLengthRemainder;
		    $sgaSectorRemainder -= $sgaChunkPayloadLengthRemainder;
		    $sgaChunkPayloadLengthRemainder = 0;
		}
		$sgaChunkPayload .= $sgaChunkPayloadCat;
	    }

	    if ( ( $sgaChunkLength & 1 ) == 1 ) {
		my $sgaDontCare = '';
		if ( $sgaBytesLeft >= 1 &&
		     read(SGA,$sgaDontCare,1) != 1 ) {
		    print STDERR "Could not get back on even boundary\n";
		}
		$sgaBytesLeft--;
		$sgaSectorRemainder--;
	    }

	    if ( length($sgaChunkPayload) != $sgaChunkLength ) {
		print STDERR "Bad file processing\n";
		return 0;
	    }

	    if ( $sgaChunkType == 0xA1 ) {
		my $sgaChunkPcmFD = unpack("n",substr($sgaChunkPayload,4,2));
		if ( $pcmData eq '' ) {
		    $pcmFD = $sgaChunkPcmFD;
		} else {
		    if ( $pcmFD != $sgaChunkPcmFD ) {
			print STDERR "Inconsistent PCM FD field\n";
			return 0;
		    }
		}
		$pcmData .= substr($sgaChunkPayload,8,$sgaChunkLength-8);
	    }
	}
    }

    if ( $pcmData ne '' ) {
	&SegaCDPCMToWave('out.wav',1,int(12500000/384.0*$pcmFD/0x800),$pcmData);
    }

    close SGA;
    return 1;
}

sub ReadFourCC {
    my ($fourCCFile) = @_;

    if ( ! open( FOURCC, $fourCCFile ) ) {
	return 0;
    }
    binmode FOURCC;
    my $fourCCHeader = '';
    if ( read(FOURCC,$fourCCHeader,4) != 4 ) {
	print STDERR "not enough characters for a fourCC file\n";
	return 0;
    }
    if ( $fourCCHeader eq 'FILM' ) {
	# Sega FILM format
	my $filmHeaderLengthString = '';
	if ( read(FOURCC,$filmHeaderLengthString,4) != 4 ) {
	    print STDERR "not enough characters for a FILM file\n";
	    return 0;
	}
	my $filmHeaderLength = unpack("N",$filmHeaderLengthString);
	if ( $filmHeaderLength < 0x10+0x14+0x10 ) {
	    print STDERR "not enough characters for a FILM header\n";
	    return 0;
	}
	my $filmHeader = '';
	seek(FOURCC,0,0);
	if ( read(FOURCC,$filmHeader,$filmHeaderLength) != $filmHeaderLength ) {
	    print STDERR "not enough characters for a FILM file\n";
	    return 0;
	}
	my $filmFormatVersion = substr($filmHeader,0x08,4);
	my $filmFDSCOffset = 0x10;
	my $filmFDSCSignature = substr($filmHeader,$filmFDSCOffset+0x00,4);
	if ( $filmFDSCSignature ne 'FDSC' ) {
	    print STDERR "expected FDSC signature\n";
	    return 0;
	}
	my $filmFDSCLength = unpack("N",substr($filmHeader,$filmFDSCOffset+0x04,4));
	if ( $filmHeaderLength < 0x10+$filmFDSCLength+0x10 ) {
	    print STDERR "not enough characters for FDSC in FILM header\n";
	    return 0;
	}
	my $filmVideoCodec = substr($filmHeader,$filmFDSCOffset+0x08,4);
	my $filmVideoHeight = unpack("N",substr($filmHeader,$filmFDSCOffset+0x0C,4));
	my $filmVideoWidth = unpack("N",substr($filmHeader,$filmFDSCOffset+0x10,4));
	my $filmSTABOffset = $filmFDSCOffset+$filmFDSCLength;
	if ( $filmSTABOffset + 16 > $filmHeaderLength ) {
	    return 0;
	}
	my $filmSTABSignature = substr($filmHeader,$filmSTABOffset+0x00,4);
	if ( $filmSTABSignature ne 'STAB' ) {
	    print STDERR "expected STAB signature\n";
	    return 0;
	}
	my $filmSTABLength = unpack("N",substr($filmHeader,$filmSTABOffset+0x04,4));
	if ( $filmHeaderLength < 0x10+$filmFDSCLength+$filmSTABLength ) {
	    print STDERR "not enough characters for STAB in FILM header\n";
	    return 0;
	}
	my $filmFrameRateBase = unpack("N",substr($filmHeader,$filmSTABOffset+0x08,4));
	my $filmSampleTableLength = unpack("N",substr($filmHeader,$filmSTABOffset+0x0C,4));
	if ( $filmSTABLength < 0x10+0x10*$filmSampleTableLength ) {
	    print STDERR "not enough characters for STAB for sample table entries\n";
	    return 0;
	}
	# Sega SATURN film has longer FDSC header
	if ( $filmFormatVersion eq (chr(0x00) x 4) &&
	     $filmVideoCodec eq 'sega' ) {
	    my $pcmData = '';
	    # my $waveCompression = 1;
	    # my $waveChannels = 1;
	    # my $waveSampleRate = 16000;
	    # my $waveAverageBytesPerSecond = 16000;
	    # my $waveBlockAlign = 1;
	    # my $waveSignificantBitsPerSample = 8;
	    # my $waveData = ('RIFF'.pack("V",0).'WAVE'.'fmt '.pack("V",16).pack("v",$waveCompression).pack("v",$waveChannels).pack("V",$waveSampleRate).pack("V",$waveAverageBytesPerSecond).pack("v",$waveBlockAlign).pack("v",$waveSignificantBitsPerSample).'data'.pack("V",0));
	    for ( my $sampleIndex = 0; $sampleIndex < $filmSampleTableLength; $sampleIndex++ ) {
		my $filmSampleOffset = $filmSTABOffset+0x10+0x10*$sampleIndex;
		my $sampleOffset = unpack("N",substr($filmHeader,$filmSampleOffset+0x00,4));
		my $sampleLength = unpack("N",substr($filmHeader,$filmSampleOffset+0x04,4));
		my $sampleInfo1 = unpack("N",substr($filmHeader,$filmSampleOffset+0x08,4));
		my $sampleInfo2 = unpack("N",substr($filmHeader,$filmSampleOffset+0x0C,4));
		seek(FOURCC,$filmHeaderLength+$sampleOffset,0);
		if ( $sampleInfo1 == 0xFFFFFFFF ) {
		    # audio sample
		    my $sample = '';
		    if ( read(FOURCC,$sample,$sampleLength) != $sampleLength ) {
			print STDERR "Could not read audio sample\n";
			return 0;
		    }
		    # for ( my $i = 0; $i < $sampleLength; $i++ ) {
		    # 	# convert from sign/magnitude to unsigned
		    # 	my $valueSM = ord(substr($sample,$i,1));
		    # 	if ( $valueSM == 0xFF ) {
		    # 	    print STDERR "seeing end of PCM flag\n";
		    # 	    return 0;
		    # 	}
		    # 	my $value;
		    # 	if ( $valueSM & 0x80 ) {
		    # 	    $value = 0x80 - ( $valueSM & 0x7F );
		    # 	} else {
		    # 	    $value = 0x80 + ( $valueSM & 0x7F );
		    # 	}
		    # 	$waveData .= chr( $value );
		    # }
		    $pcmData .= $sample;
		} else {
		    # video sample
		    # my $sampleHeader = '';
		    # if ( read(FOURCC,$sampleHeader,16) != 16 ) {
		    # 	print STDERR "Could not read sample header\n";
		    # 	return 0;
		    # }
		    # for (my $i = 0; $i < 16; $i++) {
		    # 	printf(" %2.2X",ord(substr($sampleHeader,$i,1)));
		    # }
		    # print "\n";
		}
	    }
	    # my $waveDataLength = length($waveData);
	    # substr($waveData,0x04,4) = pack("V",$waveDataLength-8);
	    # substr($waveData,0x2A,4) = pack("V",$waveDataLength-0x2E);
	    # print WAVE $waveData;
	    # close WAVE;
	    &SegaCDPCMToWave('out.wav',1,16000,$pcmData);
	} else {
	    print STDERR "currently only support sega video codec\n";
	    return 0;
	}
    } else {
	print STDERR "currently only support FILM format\n";
	return 0;
    }
}


sub SegaCDPCMToWave {
    my ($waveFile,$waveChannels,$waveSampleRate,$pcmData) = @_;
    print "$waveFile,$waveChannels,$waveSampleRate\n";
    if ( ! open( WAVE, '>'.$waveFile ) ) {
	print STDERR "Could not open $waveFile\n";
	return 0;
    }
    binmode WAVE;
    my $waveCompression = 1;
    my $waveAverageBytesPerSecond = $waveSampleRate*$waveChannels;
    my $waveBlockAlign = $waveChannels;
    my $waveSignificantBitsPerSample = 8;
    my $pcmDataLength = length($pcmData);
    my $waveData = ('RIFF'.pack("V",$pcmDataLength+36).'WAVE'.'fmt '.pack("V",16).pack("v",$waveCompression).pack("v",$waveChannels).pack("V",$waveSampleRate).pack("V",$waveAverageBytesPerSecond).pack("v",$waveBlockAlign).pack("v",$waveSignificantBitsPerSample).'data'.pack("V",$pcmDataLength));
    for ( my $i = 0; $i < $pcmDataLength; $i++ ) {
	# convert from sign/magnitude to unsigned
	my $valueSM = ord(substr($pcmData,$i,1));
	if ( $valueSM == 0xFF ) {
	    print STDERR "seeing end of PCM flag\n";
	    return 0;
	}
	my $value;
	if ( $valueSM & 0x80 ) {
	    $value = 0x80 - ( $valueSM & 0x7F );
	} else {
	    $value = 0x80 + ( $valueSM & 0x7F );
	}
	$waveData .= chr( $value );
    }
    if ( $pcmDataLength & 1 ) {
	# add unused byte if end on odd byte address
	$waveData .= chr(0x00);
    }
    print WAVE $waveData;
    close WAVE;
}
